{This file is part of CheLive.

CheLive is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

Foobar is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with Foobar.  If not, see <http://www.gnu.org/licenses/>.}

{Модуль реализует класс консоли которая служит для конфигурирования (выполнения команд/командных файлов) и ведения лога}
unit CoreConsole;

interface

uses
	SysUtils,
{$IFDEF WIN32}
	Windows,
{$ENDIF}
	CoreTypes, CoreMath, CoreInput, CoreTexture, CoreFont, Core2D;

const
	{Integer}
	CON_INT = 0;
	{Single}
	CON_FLOAT = 1;
	{Boolean}
	CON_BOOL = 2;
	{String}
	CON_STR = 3;
	{TConsoleVarProc}
	CON_PROC = 4;

type
	{Процедура обработки комманды
	@param(args строка параметров)}
	TConsoleVarProc = procedure(args: String);

	{Переменная или комманда
	@member(typ CON_INT, CON_FLOAT, CON_BOOL, CON_STR, CON_PROC)
	@member(ptr ссылка на переменную/процедуру)
	@member(myPtr признак того что память под переменную была выделена экземпляром класса)}
	TConsoleVar = class(TListItem)
		typ: Integer;
		ptr: Pointer;
		myPtr: Boolean;
		
		{Установка значения переменной, если typ = CON_INT
		@param(val значение)}
		procedure SetInt(val: Integer);
		{Установка значения переменной, если typ = CON_FLOAT
		@param(val значение)}
		procedure SetSin(val: Single);
		{Установка значения переменной, если typ = CON_BOOL
		@param(val значение)}
		procedure SetBool(val: Boolean);
		{Установка значения переменной, если typ = CON_STR
		@param(val значение)}
		procedure SetStr(val: String);
		{Установка адреса процедуры, если typ = CON_PROC
		@param(val адрес)}
		procedure SetProc(val: TConsoleVarProc);

		{Получение значения переменной, если typ = CON_INT
		@returns(значение)}
		function GetInt: Integer;
		{Получение значения переменной, если typ = CON_FLOAT
		@returns(значение)}
		function GetSin: Single;
		{Получение значения переменной, если typ = CON_BOOL
		@returns(значение)}
		function GetBool: Boolean;
		{Получение значения переменной, если typ = CON_FLOAT
		@returns(значение)}
		function GetStr: String;
		{Получение адреса процедуры, если typ = CON_PROC
		@returns(адрес)}
		function GetProc: TConsoleVarProc;

		{Конструктор
		@param(name_ задаваемое имя)
		@param(typ_ CON_INT,...)
		@param(ptr_ указатель на переменную (если nil то память под переменную будет выделена))}
		constructor Create(name_: String; typ_: Integer; ptr_: Pointer);
		destructor Destroy; override;
	end;

	TConsoleVars = specialize TList<TConsoleVar>;
	
	{Цветовая схема лога
	@member(bg фон)
	@member(text обычный текст)
	@member(info информационные сообщения (начинаются с "*", напр. информация о видео-адаптере))
	@member(sect начало секции (начинается с ">", напр. инициализация, погружение в вечный цикл))
	@member(err сообщения об ошибках (начинается с "#"))
	@member(cmd вводимая комманда)}
	TConsoleLogColors = record
		bg, text, info, sect, err, cmd: TVec4;
	end;
	
	{Лог консоли
	@member(log файл лога)
	@member(strs лог в виде массива строк)
	@member(size размер массива strs (не реальный а мнимый, т.к. размер массива изменяется не при каждом добавлении строки в лог))
	@member(font шрифт отображения лога)
	@member(color цветовая схема лога)
	@member(html если True то лог будет вестись в HTML-формате)}
	TConsoleLogParams = record
		log: Text;
		strs: TStrings;
		size: Integer;
		fontHeight: Integer;
		font: TFont;
		color: TConsoleLogColors;
		html: Boolean;
	end;
	
	{Консоль
	@member(vars список перемнных/комманд)
	@member(inpStr)
	@member(hideKey кнопка при нажатии которой консоль разблокируется если она заблокирована @seealso(TConsole.Show))
	@member(visible флаг активности консоли)
	@member(log парметры лога)
	@member(varByName получение переменной по имени)}
	TConsole = class
	private
		function GetVar(index: String): TConsoleVar;
	public
		vars: TConsoleVars;
		inpStr: String;
		hideKey: Integer;
		visible: Boolean;
		log: TConsoleLogParams;

		property varByName[index: String]: TConsoleVar read GetVar; default;
		
		{Инициализация
		@param(logFile имя файла лога)
		@param(htmlLog если True то лог будет вестись в HTML-формате)}
		procedure Init(logFile: String = 'Log.txt'; htmlLog: Boolean = False);
		{Поздняя инициализация (производиться после инициализации OpenGL)}
		procedure PostInit;
		{Вывод консоли (если visible = True)}
		procedure Render;
		{Активация консоли (монополизирует устройства ввода @seealso(TInput.Lock))
		@param(hideKey_ кнопка при нажатии которой консоль разблокируется если она заблокирована)}
		procedure Show(hideKey_: Integer);
		{Вывод сообщения в лог @seealso(TConsoleLogColors)
		@param(text текст сообщения)}
		procedure Msg(text: String); overload;
		procedure Msg(text: String; params: array of const); overload;
		{Выполнение комманды. Примеры (кавычки вводить не нужно):@br @html(<ul>
		<li>получение значения переменной: "scr.width"</li>
		<li>изменение значения меременной: "scr.width 1024"</li>
		<li>вызов комманды: "file Config.txt"</li></ul>)
		@param(text текст комманды)}
		procedure Cmd(text: String);

		{Добавление переменной/комманды @seealso(TConsoleVar.Create) @seealso(TList.Add)}
		function Add(name: String; typ: Integer = CON_INT; ptr: Pointer = nil): TConsoleVar;
		{Поиск переменной/комманды по имени @seealso(TList.Find)}
		function Find(name: String): TConsoleVar;
		{Удаление переменной/комманды @seealso(TList.Rem)}
		procedure Rem(cv: TConsoleVar);

		constructor Create;
		destructor Destroy; override;
	end;

var
	con: TConsole;

implementation

uses
	CoreOpenGL;

constructor TConsoleVar.Create(name_: String; typ_: Integer; ptr_: Pointer);
begin
	name := name_;
	typ := typ_;
	ptr := ptr_;

	myPtr := ptr = nil;

	if ptr = nil then
	begin
		case typ of
			CON_INT: New(PInteger(Self.ptr));
			CON_FLOAT: New(PSingle(Self.ptr));
			CON_BOOL: New(System.PBoolean(Self.ptr));
			CON_STR: New(PString(Self.ptr));
			CON_PROC: ;
		end;
	end;
end;

destructor TConsoleVar.Destroy;
begin
	if myPtr then
	begin
		case typ of
			CON_INT: Dispose(PInteger(ptr));
			CON_FLOAT: Dispose(PSingle(ptr));
			CON_BOOL: Dispose(System.PBoolean(ptr));
			CON_STR: Dispose(PString(ptr));
		end;
	end;
end;

procedure TConsoleVar.SetInt(val: Integer);
begin
	PInteger(ptr)^ := val;
end;

procedure TConsoleVar.SetSin(val: Single);
begin
	PSingle(ptr)^ := val;
end;

procedure TConsoleVar.SetBool(val: Boolean);
begin
	System.PBoolean(ptr)^ := val;
end;

procedure TConsoleVar.SetStr(val: String);
begin
	case typ of
		CON_INT: PInteger(ptr)^ := StrToInt(val);
		CON_FLOAT: PSingle(ptr)^ := StrToFloat(val);
		CON_STR: PString(ptr)^ := val;
		CON_PROC: ptr := Pointer(Integer(StrToInt(val)));
		CON_BOOL:
		begin
			if val = 'true' then
			begin
				System.PBoolean(ptr)^ := True;
			end else

			if val = 'false' then
			begin
				System.PBoolean(ptr)^ := False;
			end else

			begin
				System.PBoolean(ptr)^ := Boolean(StrToInt(val));
			end;
		end;
	end;
end;

procedure TConsoleVar.SetProc(val: TConsoleVarProc);
begin
	ptr := @val;
end;

function TConsoleVar.GetInt: Integer;
begin
	Result := PInteger(ptr)^;
end;

function TConsoleVar.GetSin: Single;
begin
	Result := PSingle(ptr)^;
end;

function TConsoleVar.GetBool: Boolean;
begin
	Result := System.PBoolean(ptr)^;
end;

function TConsoleVar.GetStr: String;
begin
	case typ of
		CON_INT: Result := IntToStr(PInteger(ptr)^);
		CON_FLOAT: Result := FloatToStrF(PSingle(ptr)^, ffFixed, 8, 3);
		CON_STR: Result := PString(ptr)^;
		CON_PROC: Result := IntToStr(Integer(ptr));
		CON_BOOL:
		begin
			if System.PBoolean(ptr)^ then
			begin
				Result := 'true';
			end else
			begin
				Result := 'false';
			end;
		end;
	end;
end;

function TConsoleVar.GetProc: TConsoleVarProc;
begin
	Result := TConsoleVarProc(ptr);
end;

constructor TConsole.Create;
begin
	vars := TConsoleVars.Create;
	visible := False;

	log.size := 0;
	log.fontHeight := 9;
	
	with log.color do
	begin
		bg := Vec4(0.0, 0.0, 0.0, 0.8);
		text := Vec4(0.8, 0.8, 0.8, 0.8);
		info := Vec4(0.2, 0.8, 0.2, 0.8);
		sect := Vec4(0, 0.2, 0.8, 0.8);
		err := Vec4(0.8, 0.2, 0.2, 0.8);
		cmd := Vec4(0.8, 0.8, 0.8, 0.8);
	end;
end;

destructor TConsole.Destroy;
begin
	FreeAndNil(log.font);
	FreeAndNil(vars);
	
	if log.html then
	begin
		Writeln(log.log, '<div style="padding-top: 20px; font-size: 6pt; width: 100%; text-align: center;">&copy; 2009-2010, Shutko Vitaly</div>');
		Writeln(log.log, '</body></html>');
	end;
	
	CloseFile(log.log);
end;

function TConsole.GetVar(index: String): TConsoleVar;
begin
	Result := vars.Find(index);
end;

procedure FileCmd(attrs: String);
var
	f: TextFile;
	s: String;
begin
	{$I-}
	AssignFile(f, attrs);
	Reset(f);
	{$I+}

	if IOResult <> 0 then
	begin
		//error
		Exit;
	end;

	while not EOF(f) do
	begin
		Readln(f, s);
		con.Cmd(s);
	end;

	CloseFile(f);
end;

function Vec4ToWebColor(c: TVec4): String;
var
	c3: TVec3;
begin
	c3 := Vec3(c);
	c3 *= c.w;
	
	Result := Format('#%.2x%.2x%.2x', [Round(c.x * 255), Round(c.y * 255), Round(c.z * 255)]);
end;

procedure TConsole.Init(logFile: String = 'Log.txt'; htmlLog: Boolean = False);
begin
	AssignFile(log.log, logFile);
	Rewrite(log.log);
	
	log.html := htmlLog;
	
	if log.html then
	begin
		Writeln(log.log, '<html><head><meta http-equiv="Content-Type" content="text/html;charset=UTF-8"></head>');
		Writeln(log.log, '<style type="text/css">body{color: ' + Vec4ToWebColor(log.color.text) + '; font-size: ' + IntToStr(log.fontHeight) + 'pt; font-family: "Courier New", Courier, monospace; background-color: ' + Vec4ToWebColor(log.color.bg) + ';}</style><body>');
	end;

	Add('file', CON_PROC, @FileCmd);
end;

procedure TConsole.PostInit;
begin
	log.font := TFont.Create;
	log.font.ints.Add(FONT_ANSI or FONT_CYR);
	log.font.Gen(log.fontHeight, 0, 'Courier New', 'courier', 512, 512, TEX_BI);
end;

procedure Key(key: Integer; down: Boolean);
var
	c: Char;
begin
	if not down then
	begin
		inp.keys[key] := False;
		Exit;
	end;

{$IFDEF WIN32}
	c := Char(MapVirtualKey(key, 2));
{$ENDIF}

	if key = con.hideKey then
	begin
		inp.Unlock;
		con.visible := False;
	end else

	if key = IK_ENTER then
	begin
		con.Cmd(con.inpStr);
		con.inpStr := '';
	end else

	if key = IK_BACKSPACE then
	begin
		con.inpStr := Copy(con.inpStr, 0, Length(con.inpStr) - 1);
	end else

	if (key = IK_SHIFT) then
	begin
		inp.keys[IK_SHIFT] := True;
	end else

	if ((c >= 'A') and (c <= 'Z')) or
		((c >= '0') and (c <= '9')) or
		(c = ' ') or (c = '.') or ((c = '-') and inp.KeyDown(IK_SHIFT)) then
	begin
		if (c >= 'A') and (c <= 'Z') then
		begin
			if not inp.KeyDown(IK_SHIFT) then
			begin
				c := LowerCase(c);
			end;
		end;

		if (c = '-') and inp.KeyDown(IK_SHIFT) then
		begin
			c := '_';
		end;

		con.inpStr := con.inpStr + c;
	end;
end;

procedure TConsole.Render;
var
	i, x, y, start, count, height: Integer;
	c: TVec4;
	cmdStr: String;
begin
	if not visible then
	begin
		Exit;
	end;
	
	height := Round(ogl.canvas.y / 2);
	count := Min(log.size, height div log.font.lineSkip - 1);
	start := Max(log.size - count, 0);
	x := 5;
	y := height - log.font.lineSkip * (count + 1);

	g2d.Rect(Rect(0, 0, ogl.canvas.x, height), log.color.bg, G2D_FILL);

	for i := start to log.size - 1 do
	begin
		case log.strs[i][1] of
			'*': c := log.color.info;
			'>': c := log.color.sect;
			'#': c := log.color.err;
			else c := log.color.text;
		end;

		log.font.Render(log.strs[i], x, y, c);
		y += log.font.lineSkip;
	end;

	cmdStr := '> ' + inpStr;

	log.font.Render(cmdStr, x, y, log.color.cmd);
	g2d.Rect(Rect(x + log.font.Width(cmdStr) + 2, y, log.font.logHeight * 0.6, log.font.logHeight), log.color.cmd, G2D_FILL);
end;

procedure TConsole.Show(hideKey_: Integer);
begin
	visible := True;
	hideKey := hideKey_;

	inp.Lock(@Key, True);
end;

procedure TConsole.Msg(text: String);
var
	i: Integer;
	strs: TStrings;
	c: TVec4;
begin
	strs := Explode(#13, text);

	for i := 0 to High(strs) do
	begin
		if log.size = Length(log.strs) then
		begin
			SetLength(log.strs, Length(log.strs) + 20);
		end;

		log.strs[log.size] := strs[i];
		log.size += 1;
		
		if log.html then
		begin
			case strs[i][1] of
				'*': c := log.color.info;
				'>': c := log.color.sect;
				'#': c := log.color.err;
				else c := log.color.text;
			end;
		
			Writeln(log.log, '<span style="color: ' + Vec4ToWebColor(c) + '">' + strs[i] + '</span><br />');
		end;
	end;
	
	if not log.html then
	begin
		Writeln(log.log, text);
	end;
	
	Flush(log.log);
end;

procedure TConsole.Msg(text: String; params: array of const);
begin
	Msg(Format(text, params));
end;

procedure TConsole.Cmd(text: String);
var
	v: TConsoleVar;
	name, value: String;
	i: Integer;
begin
	Msg(text);

	i := Pos(' ', text);

	if i = 0 then
	begin
		v := vars.Find(text);

		if v <> nil then
		begin
			if v.typ = CON_PROC then
			begin
				v.GetProc()('');
			end else
			begin
				Msg(v.GetStr);
			end;
		end else
		begin
			Msg('#Переменная "' + text + '" не определена');
		end;
	end else
	begin
		name := Copy(text, 1, i - 1);
		value := Copy(text, i + 1, Length(text) - i);

		v := vars.Find(name);

		if v = nil then
		begin
			Msg('#Переменная "' + name + '" не определена');
			Exit;
		end;

		if v.typ = CON_PROC then
		begin
			TConsoleVarProc(v.ptr)(value);
		end else
		begin
			v.SetStr(value);
		end;
	end;
end;

function TConsole.Add(name: String; typ: Integer = CON_INT; ptr: Pointer = nil): TConsoleVar;
begin
	Result := vars.Add(TConsoleVar.Create(name, typ, ptr));
end;

function TConsole.Find(name: String): TConsoleVar;
begin
	Result := vars.Find(name);
end;

procedure TConsole.Rem(cv: TConsoleVar);
begin
	if cv <> nil then
	begin
		vars.Rem(cv);
		cv.Free;
	end;
end;

end.

